home *** CD-ROM | disk | FTP | other *** search
/ Enter Special 3: Graphics & Video / Special_03.iso / Grafika / AutoImager 2.4 / setup_ai.exe / %MAINDIR% / Lib / gs_setpd.ps < prev    next >
Encoding:
Text File  |  2002-11-15  |  24.7 KB  |  770 lines
  1. %    Copyright (C) 1994, 2000 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of AFPL Ghostscript.
  4. % 
  5. % AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
  6. % distributor accepts any responsibility for the consequences of using it, or
  7. % for whether it serves any particular purpose or works at all, unless he or
  8. % she says so in writing.  Refer to the Aladdin Free Public License (the
  9. % "License") for full details.
  10. % 
  11. % Every copy of AFPL Ghostscript must include a copy of the License, normally
  12. % in a plain ASCII text file named PUBLIC.  The License grants you the right
  13. % to copy, modify and redistribute AFPL Ghostscript, but only under certain
  14. % conditions described in the License.  Among other things, the License
  15. % requires that the copyright notice and this notice be preserved on all
  16. % copies.
  17.  
  18. % $Id: gs_setpd.ps,v 1.8 2001/07/30 07:11:38 lpd Exp $
  19. % The current implementation of setpagedevice has the following limitations:
  20. %    - It doesn't attempt to "interact with the user" for Policy = 2.
  21.  
  22. languagelevel 1 .setlanguagelevel
  23. level2dict begin
  24.  
  25. % ---------------- Redefinitions ---------------- %
  26.  
  27. % Redefine .beginpage and .endpage so that they call BeginPage and
  28. % EndPage respectively if appropriate.
  29.  
  30. % We have to guard against the BeginPage procedure not popping its operand.
  31. % This is really stupid, but the Genoa CET does it.
  32. /.beginpage {        % - .beginpage -
  33.   .currentshowpagecount {
  34.     .currentpagedevice pop
  35.     dup null ne { /BeginPage .knownget } { pop false } ifelse {
  36.         % Stack: ... pagecount proc
  37.        count 2 .execn
  38.         % Stack: ... ..???.. oldcount
  39.        count 1 add exch sub { pop } repeat
  40.     } {
  41.       pop
  42.     } ifelse
  43.   } if
  44. } bind odef
  45.  
  46. % Guard similarly against EndPage not popping its operand.
  47. /.endpage {        % <reason> .endpage <print_bool>
  48.   .currentshowpagecount {
  49.     1 index .currentpagedevice pop
  50.     dup null ne { /EndPage .knownget } { pop false } ifelse {
  51.         % Stack: ... reason pagecount reason proc
  52.       count 2 .execn
  53.         % Stack: ... ..???.. print oldcount
  54.       count 2 add exch sub { exch pop } repeat
  55.     } {
  56.       pop pop 2 ne
  57.     } ifelse
  58.   } {
  59.     2 ne
  60.   } ifelse
  61. } bind odef
  62.  
  63. % Define interpreter callouts for handling gstate-saving operators,
  64. % to make sure that they create a page device dictionary for use by
  65. % the corresponding gstate-restoring operator.
  66. % We'd really like to avoid the cost of doing this, but we don't see how.
  67. % The names %gsavepagedevice, %savepagedevice, %gstatepagedevice,
  68. % %copygstatepagedevice, and %currentgstatepagedevice are known to the
  69. % interpreter.
  70.  
  71. (%gsavepagedevice) cvn
  72.  { currentpagedevice pop gsave
  73.  } bind def
  74.  
  75. (%savepagedevice) cvn
  76.  { currentpagedevice pop save
  77.  } bind def
  78.  
  79. (%gstatepagedevice) cvn
  80.  { currentpagedevice pop gstate
  81.  } bind def
  82.  
  83. (%copygstatepagedevice) cvn
  84.  { currentpagedevice pop copy
  85.  } bind def
  86.  
  87. (%currentgstatepagedevice) cvn
  88.  { currentpagedevice pop currentgstate
  89.  } bind def
  90.  
  91. % Define interpreter callouts for handling gstate-restoring operators
  92. % when the current page device needs to be changed.
  93. % The names %grestorepagedevice, %grestoreallpagedevice,
  94. % %restorepagedevice, %restore1pagedevice, and %setgstatepagedevice
  95. % are known to the interpreter.
  96.  
  97. /.installpagedevice
  98.  {    % Since setpagedevice doesn't create new device objects,
  99.     % we must (carefully) reinstall the old parameters in
  100.     % the same device.
  101.    .currentpagedevice pop null currentdevice null .trysetparams
  102.    dup type /booleantype eq
  103.     { pop pop }
  104.     {        % This should never happen!
  105.       DEBUG { (Error in .trysetparams!) = pstack flush } if
  106.       cleartomark pop pop pop
  107.       /.installpagedevice cvx /rangecheck signalerror
  108.     }
  109.    ifelse pop pop
  110.     % A careful reading of the Red Book reveals that an erasepage
  111.     % should occur, but *not* an initgraphics.
  112.    erasepage .beginpage
  113.  } bind def
  114.  
  115. /.uninstallpagedevice
  116.  { 2 .endpage { .currentnumcopies false .outputpage } if
  117.    nulldevice
  118.  } bind def
  119.  
  120. (%grestorepagedevice) cvn
  121.  { .uninstallpagedevice grestore .installpagedevice
  122.  } bind def
  123.  
  124. (%grestoreallpagedevice) cvn
  125.  { .uninstallpagedevice grestore .installpagedevice grestoreall
  126.  } bind def
  127.  
  128. (%restore1pagedevice) cvn
  129.  { .uninstallpagedevice grestore .installpagedevice restore
  130.  } bind def
  131.  
  132. (%restorepagedevice) cvn
  133.  { .uninstallpagedevice restore .installpagedevice
  134.  } bind def
  135.  
  136. (%setgstatepagedevice) cvn
  137.  { .uninstallpagedevice setgstate .installpagedevice
  138.  } bind def
  139.  
  140. % Redefine .currentnumcopies so it consults the NumCopies device parameter.
  141. /.numcopiesdict mark
  142.   /NumCopies dup
  143. .dicttomark readonly def
  144.  
  145. /.currentnumcopies
  146.  { currentdevice //.numcopiesdict .getdeviceparams
  147.    dup type /integertype eq
  148.     { exch pop exch pop }
  149.     { cleartomark #copies }
  150.    ifelse
  151.  } bind odef
  152.  
  153. % Redefine .currentpagedevice and .setpagedevice so they convert between
  154. % null and a fixed empty directionary.
  155. /.nullpagedevice 0 dict readonly def
  156. /.currentpagedevice {
  157.   //.currentpagedevice exch dup null eq { pop //.nullpagedevice } if exch
  158. } bind odef
  159. /.setpagedevice {
  160.   dup //.nullpagedevice eq { pop null } if //.setpagedevice
  161. } bind odef
  162.  
  163. % ---------------- Auxiliary definitions ---------------- %
  164.  
  165. % Define the required attributes of all page devices, and their default values.
  166. % We don't include attributes such as .MediaSize, which all devices
  167. % are guaranteed to supply on their own.
  168. /.defaultpolicies mark
  169.   /PolicyNotFound 1
  170.   /PageSize 0
  171.   /PolicyReport {pop} bind
  172. .dicttomark readonly def
  173. % Note that the values of .requiredattrs are executed, not just fetched.
  174. /.requiredattrs mark
  175.   /PageDeviceName null
  176.   /PageOffset [0 0] readonly
  177. % We define InputAttributes and OutputAttributes with a single
  178. % dummy media type that handles pages of any size.
  179. % Devices that care will override this.
  180.   /InputAttributes {
  181.     mark 0
  182.     % Since sizes match within 5 user units, we need to set the smallest
  183.     % PageSize to 6 units so that [0 0] will fail.
  184.     mark /PageSize [6 dup 16#7ffff dup] .dicttomark
  185.     .dicttomark
  186.   }
  187.   (%MediaSource) 0
  188.   /OutputAttributes {
  189.     mark 0 mark .dicttomark readonly .dicttomark
  190.   }
  191.   (%MediaDestination) 0
  192.   /Install {{.callinstall}} bind
  193.   /BeginPage {{.callbeginpage}} bind
  194.   /EndPage {{.callendpage}} bind
  195.   /Policies .defaultpolicies
  196. .dicttomark readonly def
  197.  
  198. % Define currentpagedevice so it creates the dictionary on demand if needed,
  199. % adding all the required entries defined just above.
  200. % We have to deal specially with entries that the driver may change
  201. % on its own.
  202. /.dynamicppkeys mark
  203.   /.MediaSize dup        % because it changes when PageSize is set
  204.   /PageCount dup
  205. .dicttomark readonly def
  206. /.makecurrentpagedevice {    % - .makecurrentpagedevice <dict>
  207.   currentdevice null .getdeviceparams
  208.     % Make the dictionary large enough to add defaulted entries.
  209.   counttomark 2 idiv .requiredattrs length add dict
  210.   counttomark 2 idiv { dup 4 2 roll put } repeat exch pop
  211.     % Add any missing required attributes.
  212.     % Make a writable and (if possible) local copy of any default
  213.     % dictionaries, to work around a bug in the output of WordPerfect,
  214.     % which assumes that these dictionaries are writable and local.
  215.   .currentglobal exch dup gcheck .setglobal
  216.   .requiredattrs {
  217.     2 index 2 index known {
  218.       pop pop
  219.     } {
  220.       exec 2 index 3 1 roll put
  221.     } ifelse
  222.   } forall exch .setglobal
  223.   dup .setpagedevice
  224. } bind def
  225. /currentpagedevice {
  226.   .currentpagedevice {
  227.     dup length 0 eq {
  228.       pop .makecurrentpagedevice
  229.     } {
  230.         % If any of the dynamic keys have changed,
  231.         % we must update the page device dictionary.
  232.       currentdevice //.dynamicppkeys .getdeviceparams .dicttomark {
  233.         % Stack: current key value
  234.         2 index 2 index .knownget { 1 index ne } { true } ifelse
  235.          { 2 index wcheck not
  236.         {    % This is the first entry being updated.
  237.             % Copy the dictionary to make it writable.
  238.           3 -1 roll dup length dict .copydict
  239.           3 1 roll
  240.         }
  241.            if
  242.            2 index 3 1 roll put
  243.          }
  244.          { pop pop
  245.          }
  246.         ifelse
  247.       } forall
  248.         % If the dictionary was global and is now local, copy
  249.         % any global subsidiary dictionaries to local VM.  This
  250.         % too is to work around the Word Perfect bug (see above).
  251.       dup gcheck not {
  252.     dup {
  253.       dup type /dicttype eq { dup gcheck } { false } ifelse {
  254.         % Copy-on-write, see above.
  255.         2 index wcheck not {
  256.           3 -1 roll dup length dict .copydict
  257.           3 1 roll
  258.         } if
  259.         .copytree 2 index 3 1 roll put
  260.       } {
  261.         pop pop
  262.       } ifelse
  263.     } forall
  264.       } if
  265.         % We would like to do a .setpagedevice so we don't keep
  266.         % re-creating the dictionary.  Unfortunately, the effect
  267.         % of this is that if any dynamic key changes (PageCount
  268.         % in particular), we will do the equivalent of a
  269.         % setpagedevice at the next restore or grestore.
  270.         % Therefore, we make the dictionary read-only, but
  271.         % we don't store it away.  I.e., NOT:
  272.         % dup wcheck { .setpagedevice .currentpagedevice pop } if
  273.       readonly
  274.     } ifelse
  275.   } if
  276. } bind odef
  277.  
  278. % Copy a dictionary recursively.
  279. /.copytree {    % <dict> .copytree <dict'>
  280.   dup length dict exch {
  281.     dup type /dicttype eq { .copytree } if 2 index 3 1 roll put
  282.   } forall
  283. } bind def
  284.  
  285. % The implementation of setpagedevice is quite complex.  Currently,
  286. % everything but the media matching algorithm is implemented here.
  287.  
  288. % By default, we only present the requested changes to the device,
  289. % but there are some parameters that require special merging action.
  290. % Define those parameters here, with the procedures that do the merging.
  291. % The procedures are called as follows:
  292. %    <merged> <key> <new_value> -proc- <merged> <key> <new_value'>
  293. /.mergespecial mark
  294.   /InputAttributes
  295.    { dup null eq
  296.       { pop null
  297.       }
  298.       { 3 copy pop .knownget
  299.      { dup null eq
  300.         { pop dup length dict }
  301.         { dup length 2 index length add dict .copydict }
  302.        ifelse
  303.      }
  304.      { dup length dict
  305.      }
  306.         ifelse .copydict readonly
  307.       }
  308.      ifelse
  309.    } bind
  310.   /OutputAttributes 1 index
  311.   /Policies
  312.     { 3 copy pop .knownget
  313.        { dup length 2 index length add dict .copydict }
  314.        { dup length dict }
  315.       ifelse copy readonly
  316.     } bind
  317. .dicttomark readonly def
  318.  
  319. % Define the keys used in input attribute matching.
  320. /.inputattrkeys [
  321.   /PageSize /MediaColor /MediaWeight /MediaType /InsertSheet
  322.     % The following are documented in Adobe's supplement for v2017.
  323.   /LeadingEdge /MediaClass
  324. ] readonly def
  325. % Define other keys used in media selection.
  326. /.inputselectionkeys [
  327.   /MediaPosition /Orientation
  328. ] readonly def
  329.  
  330. % Define the keys used in output attribute matching.
  331. /.outputattrkeys [
  332.   /OutputType
  333. ] readonly def
  334.  
  335. % Define all the parameters that should always be copied to the merged
  336. % dictionary.
  337. /.copiedkeys [
  338.   /OutputDevice
  339.   .mergespecial { pop } forall
  340.   .inputattrkeys aload pop
  341.   .inputselectionkeys aload pop
  342.   .outputattrkeys aload pop
  343. ] readonly def
  344.  
  345. % Define the parameters that should not be presented to the device.
  346. % The procedures are called as follows:
  347. %    <merged> <key> <value> -proc-
  348. % The procedure leaves all its operands on the stack and returns
  349. % true iff the key/value pair should be presented to .putdeviceparams.
  350. /.presentspecial mark
  351.   .dynamicppkeys { pop false } forall
  352.             % We must ignore an explicit request for .MediaSize,
  353.             % because media matching always handles this.
  354.   /.MediaSize false
  355.   /Name false
  356.   /OutputDevice false
  357.   /PageDeviceName false
  358.   /PageOffset false
  359.   /PageSize false        % obsolete alias for .MediaSize
  360.   /InputAttributes false
  361.   .inputattrkeys
  362.     { dup /PageSize eq
  363.        { pop }
  364.        { { 2 index /InputAttributes .knownget { null eq } { true } ifelse } }
  365.       ifelse
  366.     }
  367.   forall
  368.   .inputselectionkeys { false } forall
  369.   /OutputAttributes false
  370.   .outputattrkeys
  371.     { { 2 index /OutputAttributes .knownget { null eq } { true } ifelse } }
  372.   forall
  373.   /Install false
  374.   /BeginPage false
  375.   /EndPage false
  376.   /Policies false
  377.     % Our extensions:
  378.   /HWColorMap
  379.     {            % HACK: don't transmit the color map, because
  380.             % window systems can change the color map on their own
  381.             % incrementally.  Someday we'll have a better
  382.             % solution for this....
  383.       false
  384.     }
  385.   /ViewerPreProcess false
  386. .dicttomark readonly def
  387.  
  388. % Define access to device defaults.
  389. /.defaultdeviceparams
  390.  { finddevice null .getdeviceparams
  391.  } bind def
  392.  
  393. % Select media (input or output).  The hard work is done in an operator:
  394. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia <key> true
  395. %    <pagedict> <attrdict> <policydict> <keys> .matchmedia false
  396. %    <pagedict> null <policydict> <keys> .matchmedia null true
  397. /.selectmedia        % <orig> <request> <merged> <failed>     <-- retained
  398.             %   <attrdict> <policydict> <attrkeys> <mediakey>
  399.             %   .selectmedia
  400.  { 5 index 5 -2 roll 4 index .matchmedia
  401.         % Stack: orig request merged failed attrkeys mediakey
  402.         %   (key true | false)
  403.     { 4 index 3 1 roll put pop
  404.     }
  405.     {    % Adobe's implementations have a "big hairy heuristic"
  406.     % to choose the set of keys to report as having failed the match.
  407.     % For the moment, we report any keys that are in the request
  408.     % and don't have the same value as in the original dictionary.
  409.       5 index 1 index .knownget
  410.        { 4 index 3 1 roll put }
  411.        { 3 index exch .undef }
  412.       ifelse
  413.        {    % Stack: <orig> <request> <merged> <failed> <attrkey>
  414.      3 index 1 index .knownget
  415.       { 5 index 2 index .knownget { ne } { pop true } ifelse }
  416.       { true }
  417.      ifelse        % Stack: ... <failed> <attrkey> <report>
  418.       { 2 copy /rangecheck put }
  419.      if pop
  420.        }
  421.       forall
  422.     }
  423.    ifelse
  424.  } bind def
  425.  
  426. % Apply Policies to any unprocessed failed requests.
  427. % As we process each request entry, we replace the error name
  428. % in the <failed> dictionary with the policy value,
  429. % and we replace the key in the <merged> dictionary with its prior value
  430. % (or remove it if it had no prior value).
  431. /.policyprocs mark
  432. % These procedures are called with the following on the stack:
  433. %   <orig> <merged> <failed> <Policies> <key> <policy>
  434. % They are expected to consume the top 2 operands.
  435. % NOTE: we currently treat all values other than 0, 1, or 7 (for PageSize)
  436. % the same as 0, i.e., we signal an error.
  437.   0 {        % Set errorinfo and signal a configurationerror.
  438.     pop dup 4 index exch get 2 array astore
  439.     $error /errorinfo 3 -1 roll put
  440.     cleartomark
  441.     /setpagedevice load /configurationerror signalerror
  442.   } bind
  443.   1 {        % Roll back the failed request to its previous status.
  444. DEBUG { (Rolling back.) = pstack flush } if
  445.     3 index 2 index 3 -1 roll put
  446.     4 index 1 index .knownget
  447.      { 4 index 3 1 roll put }
  448.      { 3 index exch .undef }
  449.     ifelse
  450.   } bind
  451.   7 {        % For PageSize only, just impose the request.
  452.     1 index /PageSize eq
  453.      { pop pop 1 index /PageSize 7 put }
  454.      { .policyprocs 0 get exec }
  455.     ifelse
  456.   } bind
  457. .dicttomark readonly def
  458. /.applypolicies        % <orig> <merged> <failed> .applypolicies
  459.             %   <orig> <merged'> <failed'>
  460.  { 1 index /Policies get 1 index
  461.     { type /integertype eq
  462.        { pop        % already processed
  463.        }
  464.        { 2 copy .knownget not { 1 index /PolicyNotFound get } if
  465.             % Stack: <orig> <merged> <failed> <Policies> <key>
  466.             %   <policy>
  467.      .policyprocs 1 index .knownget not { .policyprocs 0 get } if exec
  468.        }
  469.       ifelse
  470.     }
  471.    forall pop
  472.  } bind def
  473.  
  474. % Prepare to present parameters to the device, by spreading them onto the
  475. % operand stack and removing any that shouldn't be presented.
  476. /.prepareparams        % <params> .prepareparams -mark- <key1> <value1> ...
  477.  { mark exch dup
  478.     {            % Stack: -mark- key1 value1 ... merged key value
  479.       .presentspecial 2 index .knownget
  480.        { exec { 3 -1 roll } { pop pop } ifelse }
  481.        { 3 -1 roll }
  482.       ifelse
  483.     }
  484.    forall pop
  485.  } bind def
  486.  
  487. % Put device parameters without resetting currentpagedevice.
  488. % (.putdeviceparams clears the current page device.)
  489. /.putdeviceparamsonly    % <device> <Policies|null> <require_all> -mark-
  490.             %   <key1> <value1> ... .putdeviceparamsonly
  491.             % On success: <device> <eraseflag>
  492.             % On failure: <device> <Policies|null> <req_all> -mark-
  493.             %   <key1> <error1> ...
  494.  { .currentpagedevice
  495.     { counttomark 4 add 1 roll .putdeviceparams
  496.       dup type /booleantype eq { 3 } { counttomark 5 add } ifelse -1 roll
  497.       .setpagedevice
  498.     }
  499.     { pop .putdeviceparams
  500.     }
  501.    ifelse
  502.  } bind def
  503.  
  504. % Try setting the device parameters from the merged request.
  505. /.trysetparams        % <merged> <(ignored)> <device> <Policies>
  506.             %   .trysetparams
  507.  { true 4 index .prepareparams
  508.             % Add the computed .MediaSize.
  509.             % Stack: merged (ignored) device Policies -true-
  510.             %   -mark- key1 value1 ...
  511.    counttomark 5 add index .computemediasize
  512.    exch pop exch pop /.MediaSize exch
  513. DEBUG { (Putting.) = pstack flush } if
  514.    .putdeviceparamsonly
  515. DEBUG { (Result of putting.) = pstack flush } if
  516.  } bind def
  517.  
  518. % Compute the media size and initial matrix from a merged request (after
  519. % media selection).
  520. /.computemediasize    % <request> .computemediasize
  521.             %   <request> <matrix> <[width height]>
  522.  { dup /PageSize get                    % requested page size
  523.    1 index /InputAttributes get
  524.      2 index (%MediaSource) get get /PageSize get    % media size
  525.                             % (may be a range)
  526.    2 index /Policies get
  527.      dup /PageSize .knownget
  528.       { exch pop } { /PolicyNotFound get } ifelse    % PageSize policy,
  529.                             % affects scaling
  530.    3 index /Orientation .knownget not { null } if
  531.    4 index /RollFedMedia .knownget not { false } if
  532.    matrix .matchpagesize not {
  533.         % This is a "can't happen" condition!
  534.      /setpagedevice load /rangecheck signalerror
  535.    } if
  536.    2 array astore
  537.  } bind def
  538.  
  539. % ---------------- setpagedevice itself ---------------- %
  540.  
  541. /setpagedevice
  542.  {        % We mustn't pop the argument until the very end,
  543.         % so that the pseudo-operator machinery can restore the stack
  544.         % if an error occurs.
  545.    mark 1 index currentpagedevice
  546.  
  547.         % Check whether we are changing OutputDevice;
  548.         % also handle the case where the current device
  549.         % is not a page device.
  550.         % Stack: mark <request> <current>
  551. DEBUG { (Checking.) = pstack flush } if
  552.  
  553.    dup /OutputDevice .knownget
  554.     {        % Current device is a page device.
  555.       2 index /OutputDevice .knownget
  556.        {    % A specific OutputDevice was requested.
  557.      2 copy eq
  558.       { pop pop null }
  559.       { exch pop }
  560.      ifelse
  561.        }
  562.        { pop null
  563.        }
  564.       ifelse
  565.     }
  566.     {        % Current device is not a page device.
  567.         % Use the default device.
  568.       1 index /OutputDevice .knownget not { .defaultdevicename } if
  569.     }
  570.    ifelse
  571.    dup null eq
  572.     { pop
  573.     }
  574.     { exch pop .defaultdeviceparams
  575.         % In case of duplicate keys, .dicttomark takes the entry
  576.         % lower on the stack, so we can just append the defaults here.
  577.       .requiredattrs { exec } forall .dicttomark
  578.     }
  579.    ifelse
  580.  
  581.         % Check whether a viewer wants to intervene.
  582.         % We must check both the request (which takes precedence)
  583.         % and the current dictionary.
  584.         % Stack: mark <request> <orig>
  585.    exch dup /ViewerPreProcess .knownget
  586.     { exec }
  587.     { 1 index /ViewerPreProcess .knownget { exec } if }
  588.    ifelse exch
  589.  
  590.         % Construct a merged request from the actual request plus
  591.         % any keys that should always be propagated.
  592.         % Stack: mark <request> <orig>
  593. DEBUG { (Merging.) = pstack flush } if
  594.  
  595.    exch 1 index length 1 index length add dict
  596.    .copiedkeys
  597.     {        % Stack: <orig> <request> <merged> <key>
  598.       3 index 1 index .knownget { 3 copy put pop } if pop
  599.     }
  600.    forall
  601.         % Stack: <orig> <request> <merged>
  602.    dup 2 index
  603.     {        % stack: <orig> <request> <merged> <merged> <rkey> <rvalue>
  604.       .mergespecial 2 index .knownget { exec } if
  605.       put dup
  606.     }
  607.    forall pop
  608.         % Hack: if FIXEDRESOLUTION is true, discard any attempt to
  609.         % change HWResolution.
  610.    FIXEDRESOLUTION { dup /HWResolution .undef } if
  611.         % Hack: if FIXEDMEDIA is true, discard any attempt to change
  612.         % PageSize or HWSize.
  613.    FIXEDMEDIA
  614.     { dup /PageSize 4 index /PageSize get put
  615.       dup /HWSize 4 index /HWSize get put
  616.     } if
  617.         % Hack: to work around some files that take a PageSize
  618.         % from InputAttributes and impose it, discard any attempt
  619.         % to set PageSize to a 4-element value.
  620.         % Stack: mark <orig> <request> <merged>
  621.     dup /PageSize .knownget {
  622.       length 2 ne {
  623.     dup /PageSize 4 index /PageSize get put
  624.       } if
  625.     } if
  626.  
  627.         % Select input and output media.
  628.         % Stack: mark <orig> <request> <merged>
  629. DEBUG { (Selecting.) = pstack flush } if
  630.  
  631.    0 dict    % <failed>
  632.    1 index /InputAttributes .knownget
  633.     { 2 index /Policies get
  634.       .inputattrkeys (%MediaSource) cvn .selectmedia
  635.     } if
  636.    1 index /OutputAttributes .knownget
  637.     { 2 index /Policies get
  638.       .outputattrkeys (%MediaDestination) cvn .selectmedia
  639.      } if
  640.    3 -1 roll 4 1 roll        % temporarily swap orig & request
  641.    .applypolicies
  642.    3 -1 roll 4 1 roll        % swap back
  643.  
  644.         % Construct the new device, and attempt to set its attributes.
  645.         % Stack: mark <orig> <request> <merged> <failed>
  646. DEBUG { (Constructing.) = pstack flush } if
  647.  
  648.    currentdevice .devicename 2 index /OutputDevice get eq
  649.     { currentdevice }
  650.     { 1 index /OutputDevice get finddevice }
  651.    ifelse
  652.         %**************** We should copy the device here,
  653.         %**************** but since we can't close the old device,
  654.         %**************** we don't.  This is WRONG.
  655.     %****************copydevice
  656.    2 index /Policies get
  657.    .trysetparams
  658.    dup type /booleantype ne
  659.     {        % The request failed.
  660.         % Stack: ... <orig> <request> <merged> <failed> <device>
  661.         %   <Policies> true mark <name> <errorname> ...
  662. DEBUG { (Recovering.) = pstack flush } if
  663.       counttomark 4 add index
  664.       counttomark 2 idiv { dup 4 -2 roll put } repeat
  665.       pop pop pop
  666.         % Stack: mark ... <orig> <request> <merged> <failed> <device>
  667.         %   <Policies>
  668.       6 2 roll 3 -1 roll 4 1 roll
  669.       .applypolicies
  670.       3 -1 roll 4 1 roll 6 -2 roll
  671.       .trysetparams        % shouldn't fail!
  672.       dup type /booleantype ne
  673.        { 2 { counttomark 1 add 1 roll cleartomark } repeat
  674.          /setpagedevice load exch signalerror
  675.        }
  676.       if
  677.     }
  678.    if
  679.  
  680.         % The attempt succeeded.  Install the new device.
  681.         % Stack: mark ... <merged> <failed> <device> <eraseflag>
  682. DEBUG { (Installing.) = pstack flush } if
  683.  
  684.    pop 2 .endpage
  685.     { 1 true .outputpage
  686.       (>>setpagedevice, press <return> to continue<<\n) .confirm
  687.     }
  688.    if
  689.         % .setdevice clears the current page device!
  690.    .currentpagedevice pop exch
  691.    .setdevice pop
  692.    .setpagedevice
  693.  
  694.         % Merge the request into the current page device,
  695.         % unless we're changing the OutputDevice.
  696.         % Stack: mark ... <merged> <failed>
  697.    exch currentpagedevice dup length 2 index length add dict
  698.         % Stack: mark ... <failed> <merged> <current> <newdict>
  699.    2 index /OutputDevice .knownget {
  700.      2 index /OutputDevice .knownget not { null } if eq
  701.    } {
  702.      true
  703.    } ifelse {
  704.         % Same OutputDevice, merge the dictionaries.
  705.      .copydict
  706.    } {
  707.         % Different OutputDevice, discard the old dictionary.
  708.      exch pop
  709.    } ifelse .copydict
  710.         % Initialize the default matrix, taking media matching
  711.         % into account.
  712.    .computemediasize pop initmatrix concat
  713.    dup /PageOffset .knownget
  714.     {        % Translate by the given number of 1/72" units in device X/Y.
  715.       dup 0 get exch 1 get
  716.       2 index /HWResolution get dup 1 get exch 0 get
  717.       4 -1 roll mul 72 div   3 1 roll mul 72 div
  718.       idtransform translate
  719.     }
  720.    if
  721.         % We must install the new page device dictionary
  722.         % before calling the Install procedure.
  723.   dup .setpagedevice
  724.   .setdefaultscreen    % Set the default screen before calling Install.
  725.   dup /Install .knownget {
  726.     { .execinstall } stopped { .postinstall stop } { .postinstall } ifelse
  727.   } {
  728.     .postinstall
  729.   } ifelse
  730. } odef
  731.  
  732. % We break out the code after calling the Install procedure into a
  733. % separate procedure, since it is executed even if Install causes an error.
  734. % By making .execinstall a separate operator procedure, we get the stacks
  735. % restored if it fails.
  736.  
  737. /.execinstall {        % <proc> .execinstall -
  738.     % Because the interpreter optimizes tail calls, we can't just let
  739.     % the body of this procedure be 'exec', because that would lose
  740.     % the stack protection that is the whole reason for having the
  741.     % procedure in the first place.  We hack this by adding a couple
  742.     % of extra tokens to ensure that the operator procedure is still
  743.     % on the stack during the exec.
  744.   exec
  745.   0 pop    % See above.
  746. } odef
  747. /.postinstall {        % mark ... <failed> <merged> .postinstall -
  748.    matrix currentmatrix .setdefaultmatrix
  749.         % Erase and initialize the page.
  750.    erasepage initgraphics
  751.    .beginpage
  752.  
  753.         % Clean up, calling PolicyReport if needed.
  754.         % Stack: mark ... <failed> <merged>
  755. DEBUG { (Finishing.) = pstack flush } if
  756.  
  757.    exch dup length 0 ne
  758.     { 1 index /Policies get /PolicyReport get
  759.       counttomark 1 add 2 roll cleartomark
  760.       exec
  761.     }
  762.     { cleartomark
  763.     }
  764.    ifelse pop
  765.  
  766. } odef
  767.  
  768. end                % level2dict
  769. .setlanguagelevel
  770.